home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / GAMDEV.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  746b  |  29 lines
  1. FUNCTION gamdev(VAR ia,idum: integer): real;
  2. VAR
  3.    am,e,s,v1,v2,x,y: real;
  4.    j: integer;
  5. BEGIN
  6.    IF (ia < 1) THEN BEGIN
  7.       writeln('pause in routine GAMDEV'); readln END;
  8.    IF (ia < 6) THEN BEGIN
  9.       x := 1.0;
  10.       FOR j := 1 TO ia DO x := x*ran3(idum);
  11.       x := -ln(x);
  12.    END ELSE BEGIN
  13.       REPEAT
  14.          REPEAT
  15.             REPEAT
  16.                v1 := 2.0*ran3(idum)-1.0;
  17.                v2 := 2.0*ran3(idum)-1.0;
  18.             UNTIL ((sqr(v1)+sqr(v2)) <= 1.0);
  19.             y := v2/v1;
  20.             am := ia-1;
  21.             s := sqrt(2.0*am+1.0);
  22.             x := s*y+am;
  23.          UNTIL (x > 0.0);
  24.          e := (1.0+sqr(y))*exp(am*ln(x/am)-s*y);
  25.       UNTIL (ran3(idum) <= e)
  26.    END;
  27.    gamdev := x
  28. END;
  29.